home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 001-100 / 001-025 / 013 / cardfi.bas < prev    next >
BASIC Source File  |  1995-03-17  |  15KB  |  934 lines
  1. 0     scnclr:?:?"Do a 'goto 13000' first to create the Index file":?:?"Then delete line 0 and resave this program.":stop
  2.  
  3. 1     y%=5
  4.  
  5. 2     rgb 7,8,6,4
  6.  
  7. 3     rgb 15,8,6,4
  8.  
  9. 4     rgb 2,2,8,5
  10.  
  11. 5     rgb 0,2,8,5
  12.  
  13. 6     audio 15,1
  14.  
  15. 7     screen 0,4
  16.  
  17. 10    dim dm$(12),f$(9),m$(7),mi(8),sm$(18),y$(2700),yn$(1),z$(9)
  18.  
  19. 20    e$=chr$(27):g$=chr$(7)
  20.  
  21. 30    re$=chr$(10):sp$=chr$(32):ft=0:rt=0
  22.  
  23. 40    yn$(0)="N":yn$(1)="Y":lm=1:sp=1:pf=0
  24.  
  25. 50    hf=1:for i=1 to 7:read m$(i):next i
  26.  
  27. 60    mi(0)=1:for i=1 to 7:read t:mi(i+1)=mi(i)+t
  28.  
  29. 70    for j=mi(i) to mi(i+1)-1:read sm$(j):next j,i
  30.  
  31. 80    for i=0 to 2:read dm$(i):next i
  32.  
  33. 90    bl$=sp$:for i=1 to 36:bl$=bl$+sp$
  34.  
  35. 100   l$=l$+chr$(61):next i:scnclr
  36.  
  37. 105   goto 12000
  38.  
  39. 110   pena 0:box(0,0;300,200),1:gosub 2400
  40.  
  41. 115   on error goto 0
  42.  
  43. 120   s%=sound(15,0,50,64,220)
  44.  
  45. 125   '  MAIN MENU
  46.  
  47. 130   '
  48.  
  49. 131   pena 0:box(0,24;300,149),1
  50.  
  51. 140   r$="Home Information Manager":gosub 2720
  52.  
  53. 145   box(0,24;300,149),1
  54.  
  55. 150   for i=1 to 6
  56.  
  57. 160   ?tab(1);"<";i;"> ";m$(i);re$:next i
  58.  
  59. 170   ?tab(5);"Selection -->";
  60.  
  61. 180   a$="6":gosub 2300:ms=val(k$)
  62.  
  63. 190   if k$=e$ then ms=7
  64.  
  65. 200   if (ms <>3 and ms<>4) or rt>0 then 230
  66.  
  67. 210   gosub 2700:?" No Cards Present."
  68.  
  69. 220   gosub 2100:goto 110
  70.  
  71. 230   on ms goto 240,560,900,1020,1340,1390,1890
  72.  
  73. 240   FL=29:GOSUB 3000:if k$=e$ then 130
  74.  
  75. 250   A$=STR$(FT):IF SE>2 OR RT<1 THEN 270
  76.  
  77. 260   GOSUB 2710:GOSUB 2500:if K$=E$ then 240
  78.  
  79. 265   rt=0
  80.  
  81. 270   IF FT=0 AND SE>1 THEN 440
  82.  
  83. 275   q=2
  84.  
  85. 280   ON SE GOTO 290,370,460,530
  86.  
  87. 290   GOSUB 3100:IF FT<9 THEN 320
  88.  
  89. 300   ?"A Card has Only 9 Lines!"
  90.  
  91. 310   GOSUB 2100:GOTO 240
  92.  
  93. 320   FT=FT+1:C=FT
  94.  
  95. 325   y%=5+ft
  96.  
  97. 330   H$="Line "+STR$(C)+":":T$=""
  98.  
  99. 340   GOSUB 6000:IF K$=E$ THEN FT=FT-1:GOTO 540
  100.  
  101. 350   F$(FT)=T$:IF FT<9 THEN 290
  102.  
  103. 360   gosub 3100:goto 310
  104.  
  105. 370   GOSUB 3100:IF FT<1 THEN 450
  106.  
  107. 380   A$=STR$(FT)
  108.  
  109. 390   ?"Which Line do you Want to Delete? ";
  110.  
  111. 400   gosub 2300:if k$=e$ then 540
  112.  
  113. 410   c=val(k$):if c=ft then 430
  114.  
  115. 420   for i=c to ft-1:f$(i)=f$(i+1):next i
  116.  
  117. 430   ft=ft-1:if ft>0 then 370
  118.  
  119. 440   gosub 2710
  120.  
  121. 450   ?" No Lines Present.":gosub 2100:goto 540
  122.  
  123. 460   gosub 3100
  124.  
  125. 470   ?"Change the Name of Which Line #? ";
  126.  
  127. 480   gosub 2300:if k$=e$ then 240
  128.  
  129. 490   ?k$:c=val(k$)
  130.  
  131. 500   h$="Line "+str$(c)+":":t$=f$(c)
  132.  
  133. 505   y%=12
  134.  
  135. 510   gosub 6000:if k$=e$ then 460
  136.  
  137. 520   f$(c)=t$:goto 460
  138.  
  139. 530   gosub 3100:goto 240
  140.  
  141. 540   max=0:if ft>0 then max=int(2700/ft)
  142.  
  143. 550   goto 240
  144.  
  145. 560   y%=5:q=1:w$=e$:if ft>0 then 590
  146.  
  147. 570   gosub 2700:?"You Must ";m$(1);" (option 1"
  148.  
  149. 580   ?"on Main Menu) First.":gosub 2100:goto 110
  150.  
  151. 590   if rt=max then gosub 2700:goto 650
  152.  
  153. 600   gosub 3000:if k$=e$ then 110
  154.  
  155. 610   gosub 2710:fl=38:if se=2 then 760
  156.  
  157. 620   gosub 2600
  158.  
  159. 630   rt=rt+1:if rt<max+1 then 660
  160.  
  161. 640   rt=max
  162.  
  163. 650   ?g$;dm$(2):gosub 2100:goto 110
  164.  
  165. 660   ?at(15,4);"Card ";rt
  166.  
  167. 670   c=rt:for l=1 to ft:gosub 3200
  168.  
  169. 675   y%=y%+q
  170.  
  171. 680   if k$<>e$ then y$(t)=t$:goto 700
  172.  
  173. 690   l=ft:rt=rt-1
  174.  
  175. 700   next L:if k$=e$ then 600
  176.  
  177. 710   ?l$:?dm$(0)
  178.  
  179. 720   ?at(1,20);"Cards Used: ";rt
  180.  
  181. 730   ?at(1,21);"Cards Left: ";max-rt;sp$;
  182.  
  183. 740   gosub 2200:on k$=sp$ goto 620:goto 130
  184.  
  185. 750   gosub 2710:if rt=max then 650
  186.  
  187. 760   h$="Insert Before Which Card #?":t$=""
  188.  
  189. 765   y%=5
  190.  
  191. 770   fl=39:gosub 6000:if k$=e$ then 600
  192.  
  193. 780   gosub 2710
  194.  
  195. 790   c=val(t$):if c>0 and c<rt+1 then 810
  196.  
  197. 800   ?g$;dm$(1):gosub 2100:goto 590
  198.  
  199. 810   ?tab(10);"New Card ";c
  200.  
  201. 815   y%=5:q=1
  202.  
  203. 820   y%=y%+q:for l=1 to ft:gosub 3200
  204.  
  205. 825   y%=y%+q
  206.  
  207. 830   if k$=e$ then L=ft:goto 850
  208.  
  209. 840   z$(L)=t$
  210.  
  211. 850   next L:if k$=e$ then 600
  212.  
  213. 860   for j=rt*ft to (c-1)*ft+1 step -1
  214.  
  215. 870   y$(j+ft)=y$(j):next j:rt=rt+1
  216.  
  217. 880   for j=1 to ft:y$((c-1)*ft+j)=z$(j):next j
  218.  
  219. 890   goto 750
  220.  
  221. 900   f=-1
  222.  
  223. 910   gosub 3000:if k$=e$ then 110
  224.  
  225. 920   gosub 2710:if se =2 then 1010
  226.  
  227. 925   box(0,24;300,159),1
  228.  
  229. 930   h$="Start with Which Card?":t$="":fl=32
  230.  
  231. 935   y%=5
  232.  
  233. 940   gosub 6000:if k$=e$ then 910
  234.  
  235. 950   v=val(t$):if v>0 and v<rt+1 then 970
  236.  
  237. 960   ?at(0,10);l$:?dm$(1):gosub 2100:goto 910
  238.  
  239. 970   gosub 3900:j=v
  240.  
  241. 980   w$="":gosub 4000:if w$=e$ then 910
  242.  
  243. 990   j=j+1:if j<rt+1 then 980
  244.  
  245. 1000  box(0,0;300,175),1:?dm$(2):gosub 2100:goto 910
  246.  
  247. 1010  gosub 5000:goto 910
  248.  
  249. 1020  ra$=" (1-"+str$(rt)+")?"
  250.  
  251. 1030  fl=6:gosub 3000:if k$=e$ then 110
  252.  
  253. 1040  gosub 2710:on se goto 1050,1080,1130,1140,1150
  254.  
  255. 1050  ?"Print which Card #";ra$
  256.  
  257. 1055  y%=6
  258.  
  259. 1060  gosub 3700:if rf then 1030
  260.  
  261. 1070  r1=t:r2=t:gosub 3800:goto 1020
  262.  
  263. 1080  ?"Start with which Card #";ra$
  264.  
  265. 1085  y%=6
  266.  
  267. 1090  gosub 3700:r1=t:if rf then 1030
  268.  
  269. 1100  ?"Stop with which Card #";ra$
  270.  
  271. 1105  y%=9
  272.  
  273. 1110  gosub 3700:r2=t:if (rf) or r2<r1 then 1030
  274.  
  275. 1120  gosub 3800:goto 1020
  276.  
  277. 1130  r1=1:r2=rt:gosub 3800:goto 1020
  278.  
  279. 1140  gosub 5000:goto 1020
  280.  
  281. 1150  fl=37:h$="Left Margin (0-40):"
  282.  
  283. 1155  y%=5
  284.  
  285. 1160  t$=str$(lm)
  286.  
  287. 1170  gosub 6000:if k$=e$ then 1020
  288.  
  289. 1180  lm=val(t$):if lm> -1 and lm < 41  then 1210
  290.  
  291. 1190  lm=1:?at(0,4);bl$
  292.  
  293. 1200  ?at(1,4);:goto 1160
  294.  
  295. 1210  h$="Blank Lines Between Cards (0-66):"
  296.  
  297. 1215  y%=6
  298.  
  299. 1220  t$=str$(sp)
  300.  
  301. 1230  gosub 6000:if k$=e$ then 1020
  302.  
  303. 1240  sp=val(t$):if sp > -1 and sp < 67 then 1270
  304.  
  305. 1250  sp=0:?at(0,5);bl$
  306.  
  307. 1260  ?at(1,5);:goto 1220
  308.  
  309. 1270  h$="Pause after each Card (Y/N):":t$=yn$(pf)
  310.  
  311. 1275  y%=7
  312.  
  313. 1280  gosub 6000:if k$=e$ then 1020
  314.  
  315. 1290  pf=(Left$(t$,1) = "Y")
  316.  
  317. 1300  h$="Print Line Names (Y/N):":t$=yn$(hf)
  318.  
  319. 1305  y%=8
  320.  
  321. 1310  gosub 6000:if k$=e$ then 1020
  322.  
  323. 1320  hf=(left$(t$,1) = "Y")
  324.  
  325. 1330  ?l$:gosub 2100:goto 1020
  326.  
  327. 1340  gosub 2700:on error goto 1370
  328.  
  329. 1350  box(0,24;300,149),1
  330.  
  331. 1360  ?: dir 
  332.  
  333. 1370  ?l$:gosub 2400:gosub 2100
  334.  
  335. 1380  on error goto 0:goto 110
  336.  
  337. 1383  box(0,0;300,200),1
  338.  
  339. 1385  goto 110
  340.  
  341. 1390  fl=35:box(0,24;300,149),1
  342.  
  343. 1395  y%=5
  344.  
  345. 1400  gosub 3000: if k$=e$ then 110
  346.  
  347. 1405  gosub 2400
  348.  
  349. 1410  gosub 2710
  350.  
  351. 1420  if se <> 2 or rt < 1 then 1440
  352.  
  353. 1430  gosub 2500:box(0,24;300,139),1:if k$=e$ then 1400
  354.  
  355. 1440  t$="":if se =1 then h$="Store under What Name?"
  356.  
  357. 1450  if se=2 then h$="Get which Filebox?"
  358.  
  359. 1460  if se=3 then h$="Remove which Filebox?"
  360.  
  361. 1470  gosub 6000:if t$="" or k$=e$ then 1400
  362.  
  363. 1480  if val(t$)<>0 or asc(t$) =48 then 1400
  364.  
  365. 1485  che$=t$
  366.  
  367. 1490  t$=t$+".him":box(0,25;300,149),1:on error goto 1510
  368.  
  369. 1500  on se goto 1640,1790,1620
  370.  
  371. 1510  '
  372.  
  373. 1520  box(0,24;300,149),1
  374.  
  375. 1530  close:?g$;
  376.  
  377. 1535  er=err
  378.  
  379. 1540  '
  380.  
  381. 1550  if er=57 then ?"Disk I/O Error"
  382.  
  383. 1560  if er=53 then ?"Filebox Not on This Disk"
  384.  
  385. 1570  '
  386.  
  387. 1580  if er=221 then ?"Sorry, this Disk is Full"
  388.  
  389. 1600  close:?l$:gosub 2400:gosub 2100:resume 1400
  390.  
  391. 1610  on error goto 0
  392.  
  393. 1612  gosub 2400
  394.  
  395. 1615  sleep 1*10^6:goto 1400
  396.  
  397. 1620  scratch t$
  398.  
  399. 1630  gosub 2400:goto 1610
  400.  
  401. 1640  on error goto 0
  402.  
  403. 1641  on error goto 14000
  404.  
  405. 1650  open "i",#1,t$
  406.  
  407. 1670  close :?g$;"That Filebox Already Exists"
  408.  
  409. 1680  ?"Press <space bar> to Replace It."
  410.  
  411. 1690  gosub 2400:gosub 2200:if k$=e$ then 1610
  412.  
  413. 1700  box(0,24;300,149),1:scratch t$
  414.  
  415. 1710  close #1:open "O",#1,t$
  416.  
  417. 1720  cmd 1
  418.  
  419. 1730  ?"FILEBOX":?ft:?rt
  420.  
  421. 1740  ?lm:?sp:?pf:?hf
  422.  
  423. 1750  for j=1 to ft:?f$(j)
  424.  
  425. 1760  next j:if rt=0 then 1780
  426.  
  427. 1770  for j=1 to rt*ft:?y$(j):next j
  428.  
  429. 1780  cmd 0:close #1:on error goto 0:gosub 13000:gosub 2400:goto 1610
  430.  
  431. 1790  open "i",#1,t$
  432.  
  433. 1800  close:open "I",#1,t$
  434.  
  435. 1810  '
  436.  
  437. 1815  if lof(1) < 5 then er=53:goto 1530
  438.  
  439. 1820  input#1, c$:if c$ <> "FILEBOX" then er=53:goto 1530
  440.  
  441. 1830  input#1, ft,rt,lm,sp,pf,hf
  442.  
  443. 1840  for j=1 to ft:line input#1, f$(j):next j:if rt=0 then 1860
  444.  
  445. 1850  for j=1 to rt*ft:line input#1, y$(j):next j
  446.  
  447. 1860  max=0:if ft>0 then max=int(2700/ft)
  448.  
  449. 1870  cmd 0:close
  450.  
  451. 1880  ?"Filebox is Now in Memory":getkey xr$:goto 110
  452.  
  453. 1890  gosub 3000:if se=1 or k$=e$ then 110
  454.  
  455. 1900  scnclr:end
  456.  
  457. 2000  getkey k$:return
  458.  
  459. 2100  gosub 2000: if k$<>e$ then 2100:return
  460.  
  461. 2200  gosub 2000:if k$<>e$ and k$<>sp$ then 2200
  462.  
  463. 2210  return
  464.  
  465. 2300  getkey k$:?k$
  466.  
  467. 2310  if k$ <> e$ and (k$ < "0" or k$ > a$) then 2300
  468.  
  469. 2320  return
  470.  
  471. 2400  ?at(0,23);l$
  472.  
  473. 2405  s%=sound(15,0,30,64,582)
  474.  
  475. 2410  ?at(10,24);"Press <Esc> to Exit";
  476.  
  477. 2415  '?at(0,0);l$:?re$;l$
  478.  
  479. 2420  return
  480.  
  481. 2500  ?"Warning Use of this Option will Erase"
  482.  
  483. 2510  ?"contents of All Cards from Memory."
  484.  
  485. 2520  ?:?dm$(0):gosub 2200:return
  486.  
  487. 2600  box(0,0;300,139),1:?at(0,0);:return
  488.  
  489. 2700  box(0,0;300,151),1:r$=m$(ms):goto 2720
  490.  
  491. 2710  box(0,24;300,151),1:r$=sm$(mi(ms)+se-1)
  492.  
  493. 2720  ?at(0,0);l$:?re$;l$:?at(0,2);bl$:print at(0,2);
  494.  
  495. 2730  ?spc((40-len(r$))/2);r$:?at(0,4):return
  496.  
  497. 3000  gosub 2400:box(0,20;300,167),1:gosub 2700:?:for i=mi(ms) to mi(ms+1)-1
  498.  
  499. 3010  ?tab(3);"<"i-mi(ms)+1"> "sm$(i)
  500.  
  501. 3020  ?:next i:a$=str$(mi(ms+1)-mi(ms))
  502.  
  503. 3030  ?:?tab(9)"Selection -->";
  504.  
  505. 3040  gosub 2300:se=val(k$):return
  506.  
  507. 3100  gosub 2710:if ft<1 then return
  508.  
  509. 3110  ?"LIne";0;": All Lines"
  510.  
  511. 3115  for i=1 to ft
  512.  
  513. 3120  ?"Line";I;": ";f$(i):next i
  514.  
  515. 3125  if ft>1 then q=1
  516.  
  517. 3128  y%=y%+q
  518.  
  519. 3130  ?L$:if ms=3 or ms=4 then return
  520.  
  521. 3140  if se=4 then gosub 2100
  522.  
  523. 3150  return
  524.  
  525. 3200  t=(c-1)*ft+l:h$=f$(l)+":":t$=""
  526.  
  527. 3210  if w$="C" then t$=y$(t)
  528.  
  529. 3220  gosub 6000:return
  530.  
  531. 3300  w$="":?tab(lm+15);"Card  ";j
  532.  
  533. 3310  for z=1 to ft:t$="":if hf then t$=f$(z)+": "
  534.  
  535. 3320  ?tab(lm);t$;y$((j-1)*ft+z)
  536.  
  537. 3330  get w$:if w$=e$ then z=ft:j=r2
  538.  
  539. 3340  next z:if w$=e$ then return
  540.  
  541. 3350  if sp=0 then 3370
  542.  
  543. 3360  for z=1 to sp:?:next z
  544.  
  545. 3370  gosub 2600:if pf=0 then return
  546.  
  547. 3380  close #2:cmd 0:?dm$(0):gosub 2200
  548.  
  549. 3390  open "O",#2,"prt:":if k$=sp$ then return
  550.  
  551. 3400  j=r2:return
  552.  
  553.  
  554.  
  555. 3505  s%=sound(15,0,20,64,320)
  556.  
  557. 3510  for z=1 to ft:?f$(z);" : ";y$((j-1)*ft+z)
  558.  
  559. 3520  next z:?l$:return
  560.  
  561. 3600  ?"Press <space> When Printer Ready"
  562.  
  563. 3610  gosub 2200:return
  564.  
  565. 3700  rf=1:h$="?":t$="":gosub 6000:?l$
  566.  
  567. 3710  if k$=e$ or t$="" then return
  568.  
  569. 3720  t=val(t$):if t>0 and t<=rt then rf=0:return
  570.  
  571. 3730  ?g$;dm$(1):?l$
  572.  
  573. 3740  gosub 2100:return
  574.  
  575. 3800  gosub 3600:if k$=e$ then return
  576.  
  577. 3810  open "O",#2,"prt:":cmd 2
  578.  
  579. 3820  for j=r1 to r2:gosub 3300
  580.  
  581. 3830  next j:cmd 0:close #2:return
  582.  
  583. 3900  ?at(0,19);
  584.  
  585. 3910  ?"Press <C> to Change this Card    "
  586.  
  587. 3920  ?"Press <P> to Print Card"
  588.  
  589. 3930  ?"Press <R> to Remove It, or           "
  590.  
  591. 3940  ?"Press<space bar>to Move to Next Card.":return
  592.  
  593. 4000  gosub 2600:gosub 3500
  594.  
  595. 4010  gosub 2000:if k$=e$ then w$=e$:j=rt:return
  596.  
  597. 4020  if k$=sp$ then return
  598.  
  599. 4030  if k$="C" or k$="c" then 4110
  600.  
  601. 4035  if k$="R" or k$="r" then 4170
  602.  
  603. 4040  if k$="P" or k$="p" then 4050
  604.  
  605. 4045  goto 4010
  606.  
  607. 4050  box(0,24;300,139),1
  608.  
  609. 4060  if f then gosub 3600:if k$=e$ then 4100
  610.  
  611. 4070  f=0:?"Now Printing Card ";j
  612.  
  613. 4080  open "O",#2,"prt:":cmd 2
  614.  
  615. 4090  gosub 3300:cmd 0:close #2
  616.  
  617. 4100  j=j-1:gosub 3900:return
  618.  
  619. 4110  box(0,0;300,139),1:gosub 2710
  620.  
  621. 4115  q=1:y%=6
  622.  
  623. 4120  fl=39:?tab(15);"Card ";j
  624.  
  625. 4130  c=j:w$="C":for l=1 to ft:gosub 3200
  626.  
  627. 4135  y%=y%+1
  628.  
  629. 4140  if k$=e$ then l=ft:goto 4160
  630.  
  631. 4150  y$(t)=t$
  632.  
  633. 4160  next l:j=j-1:gosub 3900:return
  634.  
  635. 4170  box(0,24;300,139),1:gosub 3500
  636.  
  637. 4180  ?"Press <space> to Remove This Card";
  638.  
  639. 4190  gosub 2200:gosub 3900:if k$=e$ then j=j-1:return
  640.  
  641. 4200  if j=rt then 4230
  642.  
  643. 4210  for z=(j-1)*ft+1 to (rt-1)*ft
  644.  
  645. 4220  y$(z)=y$(z+ft):next z
  646.  
  647. 4230  rt=rt-1:j=j-1:return
  648.  
  649. 5000  gosub 3110:a$=str$(ft)
  650.  
  651. 5010  w$="":?"Select Cards by Which Line?";
  652.  
  653. 5020  gosub 2300:if k$=e$ then return
  654.  
  655. 5030  v=val(k$):gosub 2600
  656.  
  657. 5032  bb=1
  658.  
  659. 5035  if v=0 then bb=v:v=1
  660.  
  661. 5040  y%=2:?"What Text to Search For?"
  662.  
  663. 5050  fl=38:h$="?":t$="":gosub 6000
  664.  
  665. 5060  if k$=e$ or t$="" then return
  666.  
  667. 5070  box(0,24;300,139),1:?
  668.  
  669. 5080  ?tab(5);"<1> Match from Begin or Line"
  670.  
  671. 5090  ?re$;tab(5);"<2> Search Whole Line":?
  672.  
  673. 5100  a$="2":?tab(9);"Selection -->";
  674.  
  675. 5110  gosub 2300:if k$=e$ then return
  676.  
  677. 5120  sf=0:sr$=t$:ls=len(sr$)
  678.  
  679. 5130  j=1:if k$="2" then 5215
  680.  
  681. 5140  box(0,0;300,139),1
  682.  
  683. 5150  ?at(0,10);"Checking Card ";j
  684.  
  685. 5160  if sr$ <> left$(y$((j-1)*ft+v),ls) then 5180
  686.  
  687. 5170  sf=1:w$="":gosub 3900:gosub 4000:box(0,24;300,139),1
  688.  
  689. 5180  get x$
  690.  
  691. 5190  if w$=e$ or x$=e$ then return
  692.  
  693. 5195  if bb=0 then v=v+1:if v<= ft then 5150
  694.  
  695. 5200  j=j+1:if j<= rt then 5150
  696.  
  697. 5210  goto 5330
  698.  
  699. 5215  box(0,0;300,139),1
  700.  
  701. 5220  z$=y$((j-1)*ft+v):lz=len(z$)
  702.  
  703. 5230  ?at(0,10);"Checking Card ";j;" line ";v
  704.  
  705. 5240  if z$="" then 5320
  706.  
  707. 5250  for w=1 to lz-ls+1
  708.  
  709. 5260  if sr$ <> Mid$(z$,w,ls) then 5280
  710.  
  711. 5270  w=256:sf=1:w$="":gosub 3900:gosub 4000:box(0,0;300,139),1
  712.  
  713. 5280  get x$
  714.  
  715. 5290  if w$=e$ or x$=e$ then w=300
  716.  
  717. 5300  next w
  718.  
  719. 5310  if w$=e$ or (x$=e$ and k$<>e$) then return
  720.  
  721. 5315  if bb=0 then v=v+1: if v<=ft then 5220 else v=1
  722.  
  723. 5320  j=j+1:if j<rt+1 then 5220
  724.  
  725. 5330  box(0,0;300,139),1:if sf<1 then 5350
  726.  
  727. 5340  ?"No More Cards Match":gosub 2100:return
  728.  
  729. 5350  ?"No Cards Match":gosub 2100:return
  730.  
  731. 6000  ?at(0,y%);h$;:x%=pos(0)
  732.  
  733. 6010  pc=2:t$=sp$+t$
  734.  
  735. 6020  ?at(x%+1,y%);t$;
  736.  
  737. 6030  ?at(x%+pc,y%);"";
  738.  
  739. 6040  line input;k$
  740.  
  741. 6042  if (w$="C" or w$="c") and len(k$)=0 then t$=y$(t):goto 6160
  742.  
  743. 6044  if len(k$)=0 then k$=e$
  744.  
  745. 6045  goto 6150
  746.  
  747. 6050  if asc(kk$)<>155 and k > 31 then 6120
  748.  
  749. 6060  er=(k=13)+(k=27):if er then 6150
  750.  
  751. 6070  cu=(k=67)-(k=8):if k=4 then 6110
  752.  
  753. 6080  if cu=0 then 6030
  754.  
  755. 6090  pc=pc+cu:pc=pc+(pc<2)-(pc>len(t$)+1)
  756.  
  757. 6100  goto 6030
  758.  
  759. 6110  t$=left$(t$,pc-1)+mid$(t$,pc+1,len(t$)):goto 6020
  760.  
  761. 6120  if len(t$) > fl-x%-1 then 6040
  762.  
  763. 6130  t$=left$(t$,pc-1)+k$+mid$(t$,pc,len(t$))
  764.  
  765. 6140  pc=pc+1:goto 6020
  766.  
  767. 6150  t$=k$
  768.  
  769. 6160  ?at(x%+2,y%);t$;sp$
  770.  
  771. 6170  return
  772.  
  773. 7000  DATA Design Card Format, Add Card(s)
  774.  
  775. 7010  data Display/Change/Remove Card(s),Print Card(s)
  776.  
  777. 7020  data List All Files on Disk
  778.  
  779. 7030  data Get New/Store/Remove Filebox,Quit
  780.  
  781. 7040  data 4,Add New Lines,Delete Lines
  782.  
  783. 7050  data Change Names of Lines,Display Card Format
  784.  
  785. 7060  data 2,Add at End,Insert Before End
  786.  
  787. 7070  data 2,Look at Cards Consecutively
  788.  
  789. 7080  data Work with Selected Card(s)
  790.  
  791. 7090  data 5,Print One Card,Print a Range of Cards
  792.  
  793. 7100  data Print All Cards,Print Selected Card(s)
  794.  
  795. 7110  data Change Printer Options,1,Disk
  796.  
  797. 7120  data 3,Store This Filebox on Disk
  798.  
  799. 7130  data Get a Filebox from Disk
  800.  
  801. 7140  data Remove a File from Disk
  802.  
  803. 7150  data 2,Return to Main Menu,Quit
  804.  
  805. 8000  data "Press <space bar> to continue."
  806.  
  807. 8010  data No Such Card!,No More Cards
  808.  
  809. 10000 scnclr
  810.  
  811. 10010 rgb 4,12,1,1
  812.  
  813. 10020 rgb 14,1,3,6
  814.  
  815. 10030 peno 1
  816.  
  817. 10040 outline 1
  818.  
  819. 10050 graphic(1)
  820.  
  821. 10060 x=144:y=24
  822.  
  823. 10070 for num =1 to 7
  824.  
  825. 10080 pena 13
  826.  
  827. 10090 area(x,y to x+60,y to x+60,y-10 to x+140,y-10 to x+150,y to x+150,y+60 to x,y+60)
  828.  
  829. 10100 pena 4:penb 13
  830.  
  831. 10105 draw(x+140,y-10 to x+140,y to x+150,y)
  832.  
  833. 10110 ?at(x+62,y-2);fa$(num)
  834.  
  835. 10120 pena 14
  836.  
  837. 10130 ?at(x+1,y+8);num
  838.  
  839. 10140 x=x-16:y=y+16
  840.  
  841. 10150 next
  842.  
  843. 10160 z=2
  844.  
  845. 10170 pena z mod 2:penb 0
  846.  
  847. 10172 xx%=z*100
  848.  
  849. 10174 if xx% > 800 then xx%=200:z=2
  850.  
  851. 10175 s%=sound(15,0,20,64,xx%)
  852.  
  853. 10176 audio 15,1
  854.  
  855. 10180 ?at(10,10);"Select Folder # ?";:get ke$:if ke$ = "" then z=z+1 :pena z mod 2:sleep .4*10^6:goto 10170
  856.  
  857. 10190 t$=fa$(val(ke$)):graphic(0)
  858.  
  859. 10195 outline 0
  860.  
  861. 10200 rgb 0,10,7,2
  862.  
  863. 10210 rgb 2,10,7,2
  864.  
  865. 10290 on error goto 11000
  866.  
  867. 10300 t$=t$+".him"
  868.  
  869. 10310 open "i",#1,t$
  870.  
  871. 10320 input#1, c$:if c$<>"FILEBOX" then er=53:goto 1530
  872.  
  873. 10330 input#1, ft,rt,lm,sp,fp,hf
  874.  
  875. 10340 for j=1 to ft:input#1,f$(j):next j:if rt=0 then 10360
  876.  
  877. 10350 for j=1 to rt*ft:input#1,y$(j):next j
  878.  
  879. 10360 max=0:if ft>0 then max=int(2700/ft)
  880.  
  881. 10370 close #1
  882.  
  883. 10375 graphic(0)
  884.  
  885. 10380 ?"Filebox is Now in Memory":?"Press a key            ":getkey xr$
  886.  
  887. 11000 if err=53 then graphic(0):resume 110
  888.  
  889. 11100 goto 110
  890.  
  891. 12000 'on error goto 13000
  892.  
  893. 12010 open "i",#3,"Index.him"
  894.  
  895. 12030 for j=1 to 7
  896.  
  897. 12040 input#3,fa$(j)
  898.  
  899. 12060 next j:close #3
  900.  
  901. 12065 on error goto 0
  902.  
  903. 12070 goto 10000
  904.  
  905. 13000 close
  906.  
  907. 13010 open "o",#3,"Index.him"
  908.  
  909. 13020 p$(1)="Address"
  910.  
  911. 13030 ?#3,p$(1)
  912.  
  913. 13050 for j=2 to 7
  914.  
  915. 13060 p$(J)=fa$(j)
  916.  
  917. 13070 next j
  918.  
  919. 13080 if se=1 then p$(val(ke$))=che$
  920.  
  921. 13090 for j=2 to 7
  922.  
  923. 13100 ?#3,p$(j)
  924.  
  925. 13110 next j
  926.  
  927. 13115 close #3
  928.  
  929. 13120 return
  930.  
  931. 14000 resume 1710
  932.  
  933. 65000 ' FAMILY COMPUTING NOV. 85
  934.